perm filename WAVE.SAI[SYS,HE]4 blob sn#084255 filedate 1974-01-29 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00026 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	IFC NOMOVE THENC
C00006 00003	REQUIRE "HASH06.REL[SYS,HE]" LOAD_MODULE
C00011 00004	SIMPLE STRING PROCEDURE SIMIO(REFERENCE INTEGER BR)
C00012 00005	SIMPLE INTEGER PROCEDURE GETNAME(BOOLEAN NUMREFERENCE STRING SSTRING ARRAY NAME)
C00017 00006	STRING WAIT,LFILE,OFILE,SL
C00020 00007	REAL R
C00021 00008	SIMPLE PROCEDURE CONSTRUCT(SAFE REAL ARRAY T,E)
C00023 00009	FORMAT_POINTER←-1
C00025 00010	WAIT←"O.K."
C00032 00011	BEGIN "DOIT"
C00037 00012	BEGIN "BEGIN"
C00042 00013	BEGIN"FREE"
C00044 00014	BEGIN"OPEN_HAND"
C00046 00015	BEGIN"CHANGE"
C00049 00016	IF LENGTH(FILE) THEN FLUSH(0,LAST_ARM)
C00051 00017	BEGIN"LINK"
C00056 00018	BEGIN "DEFINE"
C00059 00019	BEGIN "DUMP"
C00063 00020	BEGIN"SET"
C00064 00021	BEGIN "EDIT"
C00068 00022	BEGIN "NNUL" SAY_WAITNO_NULL END"NNUL"
C00071 00023	BEGIN"MOVING"
C00074 00024	IFC GRAPHICS THENC
C00079 00025	SL←SIMIO(ONE_LINE)
C00084 00026	END ELSE
C00086 ENDMK
C⊗;
IFC NOMOVE THENC
DEFINE TSX="1.0017",TSY="1.0028";
DEFINE TYP_HAND="FALSE",DEB_HAND="FALSE";
FORWARD MESSAGE SIMPLE PROCEDURE START_TRAJECTORY(STRING FILE;INTEGER SFL);
INTERNAL INTEGER ARM_MOTION,ARM_STATUS,ARM_SEGMENT,ARM_WAIT,
	ARM_TIME,ARM_EXECUTE;
INTERNAL BOOLEAN STOP_ON_TOUCH;
INTERNAL INTEGER ARRAY FELT[1:2,1:4,1:4];
REAL ARRAY ARM_LINK[3:6,1:4,1:4];
REAL GRASP;
INTERNAL SAFE REAL ARRAY ARM_VECTOR[1:7];
INTEGER ARM_PLAN;
SAFE REAL ARRAY FREE_ARM[0:6,1:6];
SAFE REAL ARRAY FORCE_ARM[1:6];
INTEGER GDISP_INIT;INTEGER ARRAY GDISP[0:14];
REQUIRE "INTFAC.REL[SYS,HE]" LOAD_MODULE;
ELSEC
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "DRIVE.REL[SYS,HE]" LOAD_MODULE;
ENDC
EXTERNAL SIMPLE PROCEDURE ARMPOS;
EXTERNAL SIMPLE PROCEDURE HANDFN;
EXTERNAL SIMPLE PROCEDURE ARMFN(INTEGER NARGS);
EXTERNAL SIMPLE PROCEDURE ARMPROCEED(BOOLEAN REPEAT);
EXTERNAL SIMPLE PROCEDURE DOIT(INTEGER PPPN,BAND,FILE);
EXTERNAL SIMPLE PROCEDURE ARM_JOINT;
REAL ROTAT;
BOOLEAN INTERP;
SAFE REAL ARRAY TRANS[1:4,1:4];
INTERNAL SAFE INTEGER ARRAY ARM_MESSAGE[1:21];
INTEGER IFI,I,J,MESS;
BOOLEAN FRST_OPEN,AEF;
BOOLEAN TEST;
INTEGER N,CHAN;
REAL TX,TY,TZ;
INTEGER HAND;
STRING S,FILE;
INTEGER BREAK,EOF;
INTEGER NNUL,PTR2,PTR3,PTR4;
SAFE REAL ARRAY TH,DIR[1:6];
PRELOAD_WITH -180.0, -90.0, 12.0, -90.0, 90.0, 0.0;
SAFE REAL ARRAY V0[1:6];
LABEL EXETRUE,GGET,GET,GET1;
DEFINE TTY="1",ONE_LINE="1",HEAD="2",ID="3",DEL="4";
DEFINE OCTNUM="5",RSB="6",LN="7",SOME="10";
DEFINE NUMS="11",NNUMS="12",DOLLAR="13",SOMETHING="14";
DEFINE FF="15",SEMI="16",ALT_MODE="'175";
DEFINE FREE_DATA_LENGTH="100",MAX_STACK="150";
SAFE INTEGER ARRAY STACK[1:MAX_STACK];
SAFE INTEGER ARRAY COEFF[0:'1037];	
REQUIRE "HASH06.REL[SYS,HE]" LOAD_MODULE;
EXTERNAL SIMPLE INTEGER PROCEDURE HASH(STRING S);
EXTERNAL SIMPLE INTEGER PROCEDURE REHASH;
STRING EDIT_NAME,LINE_NO,SPACES;
SAFE REAL ARRAY XT[1:4,1:4];
SAFE REAL ARRAY XV,YV,ZV[1:4];
DEFINE MAX_MACRO="20";
STRING ARRAY MACRO_FORMAL,MACRO_NAME,MACRO_SOURCE,MACRO_DEFN,FILE_NAME[1:MAX_MACRO];
SAFE INTEGER ARRAY MAC_TOP[0:MAX_MACRO-1];
INTEGER FMN,MAC_EOF,MAC,MAC_FREE;
DEFINE MAX_PAR="30";
SAFE STRING ARRAY MAC_PAR[1:MAX_PAR];
DEFINE MAX_LABELS="100";
STRING ARRAY LABEL_LINE,LABELS[1:MAX_LABELS];
INTEGER ARRAY BBEG,LLAB[0:15];
INTEGER FREEL;
INTEGER ARRAY PTRS[1:MAX_LABELS];
STRING ARRAY CODE_LINE,REF[1:MAX_STACK];
STRING ARRAY FUNNAM[0:'77];
INTEGER ARRAY FUNNUM[0:'77];
STRING ARRAY VECTNAM[0:'77];
STRING ARRAY TRANSNAM[0:'77];
INTEGER ARRAY TRANSNUM[0:'77];
INTEGER ARRAY VECTNUM[0:'77];
PRELOAD_WITH [3] 0, 1.0,[3] 0, 1.0, [3] 0, 1.0;
SAFE REAL ARRAY DATA_BASE[0:FREE_DATA_LENGTH,1:3];
INTEGER FREE_DATA;
SIMPLE STRING PROCEDURE ERRORS;
BEGIN
	IF ARM_STATUS = 1 THEN RETURN("Arithmetic Overflow occured. Something bad has happened.");
	IF ARM_STATUS LAND '7 = 1 THEN RETURN("Excessive force occured at joint "&CVS(ARM_STATUS LSH -3));
	IF ARM_STATUS = 2 THEN RETURN("Hand closed more than minimum specified in CLOSE function");
	IF ARM_STATUS = 3 THEN RETURN("File not found");
	IF ARM_STATUS = 4 THEN RETURN("Someone has pawned the DSK");
	IF ARM_STATUS = 5 THEN RETURN("Someone has sold the DSK");
	IF ARM_STATUS LAND '7 = 6 THEN RETURN("Touch sensors "&CVOS(ARM_STATUS LSH -3)&" have touched something");
	IF ARM_STATUS = 7 THEN RETURN("Cannot read the joint positions, usually hardware trouble.");
	IF ARM_STATUS = '20 THEN RETURN("Function took too long to execute");
	IF ARM_STATUS = '22 THEN RETURN("Hand function took too long to execute.");
	IF ARM_STATUS = '23 THEN RETURN("Arm failed to reach force limit set by STOP during motion.");
	IF ARM_STATUS = '24 THEN RETURN("Arm in L1: JUMP L1 type loop.");
	IF ARM_STATUS = '25 THEN RETURN("Save array number out of bound");
	IF ARM_STATUS = '27 THEN RETURN("The function you have called is disconnected.");
	IF ARM_STATUS = '30 THEN RETURN("The arm is down");
	IF ARM_STATUS = '50 THEN RETURN("Librascope read error");
	IF ARM_STATUS = '60 THEN RETURN("You have a very old program which does not match the current servo");
	IF ARM_STATUS = '70 THEN RETURN("The reference supply used by the arm is off.");
	IF ARM_STATUS = '100 THEN RETURN("The PDP6 is not running.");
 	IF ARM_STATUS = '200 THEN RETURN("The servo program has been interrupted.");
	IF ARM_STATUS = '300 THEN RETURN("The A/D is busy, mabye Colby is running");
	IF ARM_STATUS = '400 THEN RETURN("The XGP is in use which upsets the arm");
	IF ARM_STATUS = '500 THEN RETURN("Arm solution does not exist");
	IF ARM_STATUS = '600 THEN RETURN("SOJG cell does not exist or there are too many");
	RETURN("Unrecognized error state");
END;

SIMPLE STRING PROCEDURE SIMIO(REFERENCE INTEGER BR);
BEGIN STRING S;
	IF MAC
      THEN BEGIN S←SCAN(MACRO_SOURCE[MAC],BR,BREAK);
  		 MAC_EOF←¬(LENGTH(MACRO_SOURCE[MAC]) ∨ LENGTH(S)) END
      ELSE S←INPUT(CHAN,BR);
      RETURN(S) END"SIMIO";

SIMPLE INTEGER PROCEDURE GETNAME(BOOLEAN NUM;REFERENCE STRING S;STRING ARRAY NAME);
BEGIN	LABEL L1;
	STRING SN;
	INTEGER I;
L1:	IF NUM THEN SIMIO(NUMS) ELSE SIMIO(HEAD);
	IF MAC_EOF
	THEN BEGIN
		FOR I←LLAB[MAC] STEP 1 UNTIL FREEL
		DO FOR J←BBEG[MAC] STEP 1 UNTIL PTR3+1
		   DO IF EQU(REF[J],LABELS[I])
		      THEN BEGIN
			IF STACK[J] LAND '77000000 = '26000000 THEN BEGIN
			   N←PTRS[I]-J+COEFF[(STACK[J] LAND '777777) + 1];
			   REF[J]←NULL;
			   IF N+J<1 ∨ N+J>PTR3+1
			   THEN BEGIN
				OUTSTR(CODE_LINE[J]&"JUMP OUT OF RANGE"&'15&'12);
				N←PTR3+1-J END;
			   COEFF[(STACK[J] LAND '777777) +1]←N END ELSE
			   BEGIN
			   START_CODE
				MOVE 1,STACK;
				ADD 1,J;
				HRRE 1,-1(1);
				MOVEM 1,N END;
			   N←PTRS[I]-J+N;
			   REF[J]←NULL;
			   IF N+J<1 ∨ N+J>PTR3+1
			   THEN BEGIN
				OUTSTR(CODE_LINE[J]&"JUMP OUT OF RANGE"&'15&'12);
				N←PTR3+1-J END;
			   STACK[J]←(N LAND '777777) LOR (STACK[J] LAND '777000000) END;END;
		FOR J←BBEG[MAC] STEP 1 UNTIL PTR3
		DO IF LENGTH(REF[J])
		THEN BEGIN OUTSTR(CODE_LINE[J]&REF[J]&" UNDEFINED"&'15&'12);
			STACK[J]←(PTR3+1-J) LOR '102000000;
			REF[J]←NULL;
			LABEL_LINE[J]←NULL END;
		MAC_FREE←MAC_TOP[MAC];
		FREEL←LLAB[MAC]-1;
		MAC←MAC-1;
		MAC_EOF←0;
		IF ¬MAC ∧ CHAN=1 THEN BEGIN LINE_NO←NULL;OUTSTR("*")END;
		GO TO L1 END;
	IF EOF THEN BEGIN RELEASE(CHAN);
		CHAN←CHAN-1;
		IF ¬MAC ∧ CHAN=1 THEN BEGIN LINE_NO←NULL;OUTSTR("*")END;
		GO TO L1; END;
	IF BREAK=-1
	THEN BEGIN LINE_NO←SIMIO(LN);
		GO TO L1 END;
	IF BREAK=";" THEN BEGIN SIMIO(ONE_LINE); GO TO L1 END;
	IF BREAK="$"
	THEN BEGIN I←INTSCAN(S←SIMIO(NNUMS),J);
	     I←I+MAC_TOP[MAC];
	     IF I<1 ∨ I> MAC_FREE
	     THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"MACRO PARAMETER OUT OF RANGE"&'15&'12);
		  GO TO L1 END;
	     S←MAC_PAR[I] END
	ELSE S←IF NUM THEN SIMIO(NNUMS) ELSE SIMIO(ID);
	IF NUM THEN BEGIN
		SN←SCAN(S,DOLLAR,J);
		IF J="$" THEN BEGIN
			I←INTSCAN(S,J);
			I←I+MAC_TOP[MAC];
			IF I<1 ∨ I> MAC_FREE
			THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"MACRO PARAMETER OUT OF RANGE"&'15&'12);
				GO TO L1 END;
			S←SN&MAC_PAR[I] END ELSE S←SN;
		RETURN(-1) END;
	IF BREAK=":"
	THEN BEGIN
		FOR I←LLAB[MAC] STEP 1 UNTIL FREEL
		DO IF EQU(S,LABELS[I])
		   THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&S&" MULTIPLY DEFINED LABEL"&'15&'12);
			GO TO L1 END;
		LABELS[FREEL←FREEL+1]←S;
		LABEL_LINE[FREEL]←FILE_NAME[CHAN]&LINE_NO;
		PTRS[FREEL]←PTR3+1;
		GO TO L1 END;
	I←HASH(S);
	WHILE LENGTH(NAME[I])
	DO BEGIN IF EQU(S,NAME[I]) THEN DONE;
		I←REHASH END;
	RETURN(I) END;

STRING WAIT,LFILE,OFILE,SL;
SIMPLE PROCEDURE OPEN_ONE;
IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((LFILE←FILE←OFILE),0);

FORWARD SIMPLE PROCEDURE CONSTRUCT(SAFE REAL ARRAY T,E);

SIMPLE INTEGER PROCEDURE INTERN(STRING S;STRING ARRAY NAME);
BEGIN	INTEGER I;
	I←HASH(S);
	WHILE LENGTH(NAME[I])
	DO BEGIN IF EQU(S,NAME[I]) THEN RETURN(I);
		I←REHASH END;
	NAME[I]←S;
	RETURN(I) END;

DEFINE SAY_WAIT="IF ¬MAC ∧ CHAN=1 THEN OUTSTR(WAIT&'15&'12)";

BOOLEAN SIMPLE PROCEDURE READT(REAL ARRAY T;REFERENCE STRING S;STRING MESS);
BEGIN	INTEGER I;
	SAFE OWN REAL ARRAY E[1:6];
	I←GETNAME(FALSE,S,TRANSNAM);
	IF LENGTH(TRANSNAM[I])
	THEN BEGIN ARRBLT(E[1],DATA_BASE[TRANSNUM[I],1],6);
		CONSTRUCT(T,E);
		RETURN(TRUE) END;
	OUTSTR(FILE_NAME[CHAN]&LINE_NO&MESS&'15&'12);
	RETURN(FALSE) END;

BOOLEAN SIMPLE PROCEDURE READV(REAL ARRAY V;REFERENCE STRING S;STRING MESS);
BEGIN	INTEGER I;
	I←GETNAME(FALSE,S,VECTNAM);
	IF LENGTH(VECTNAM[I])
	THEN BEGIN ARRBLT(V[1],DATA_BASE[VECTNUM[I],1],3);
		V[4]←1;
		RETURN(TRUE) END;
	OUTSTR(FILE_NAME[CHAN]&LINE_NO&MESS&'15&'12);
	RETURN(FALSE) END;

SAFE REAL ARRAY TT1[1:4,1:4];
PRELOAD_WITH 20,30,1,180,90,0; SAFE REAL ARRAY ANEW[1:6];
IFC GRAPHICS THENC
REQUIRE"DPYSUB.HDR[SYS,HE]" SOURCE_FILE;
ENDC
STRING FUNCTION,S11,SM,DFILE;
PRELOAD_WITH 100.0, 100.0, 100.0, 100.0, 100.0, 100.0;
SAFE REAL ARRAY THFAC[1:6];
REAL R;
SAFE REAL ARRAY VT,VT1,VT2[1:4];
PRELOAD_WITH [2] 0.0, [2] 1.0;
SAFE REAL ARRAY UZ[1:4];
SAFE REAL ARRAY ST[1:6];
INTEGER NMASK,TIP,PAD,HIT,LL,UL,MODULUS,PTR,TIME,INDEX,BP;
REAL FACTOR;
PRELOAD_WITH 0;
SAFE INTEGER ARRAY BUFFER[0:100];
REQUIRE "TRAJ.SAI" SOURCE_FILE;

SIMPLE PROCEDURE CONSTRUCT(SAFE REAL ARRAY T,E);
BEGIN
	REAL SI1,SI2,SI3,CO1,CO2,CO3;
	T[1,4]←E[1]*TSX;
	T[2,4]←E[2]*TSY;
	T[3,4]←E[3];
	SI1←SIND(E[4]);CO1←COSD(E[4]);
	SI2←SIND(E[5]);CO2←COSD(E[5]);
	SI3←SIND(E[6]);CO3←COSD(E[6]);
	T[1,1]←-SI1*SI2*CO3+CO1*SI3;
	T[1,2]← SI1*SI2*SI3+CO1*CO3;
	T[2,1]← CO1*SI2*CO3+SI1*SI3;
	T[2,2]←-CO1*SI2*SI3+SI1*CO3;
	T[1,3]← SI1*CO2;
	T[2,3]←-CO1*CO2;
	T[3,1]←-CO2*CO3;
	T[3,2]← CO2*SI3;
	T[3,3]←-SI2;
	T[4,1]←T[4,2]←T[4,3]←0;
	T[4,4]←1;
END;

SIMPLE PROCEDURE UNSTRUCT(SAFE REAL ARRAY T,E);
BEGIN
	REAL CO2;
	E[1]←T[1,4]/TSX;
	E[2]←T[2,4]/TSY;
	E[3]←T[3,4];
	E[5]←RAD*ATAN2(-T[3,3],CO2←SQRT(T[1,3]↑2+T[2,3]↑2));
	IF CO2<0.01 THEN BEGIN
		E[4]←RAD*ATAN2(T[2,2],T[1,2]);
		E[6]←0;
		RETURN END;
	E[4]←RAD*ATAN2(T[1,3],-T[2,3]);
	E[6]←RAD*ATAN2(T[3,2],-T[3,1])
END;

FORMAT_POINTER←-1;
INTERP←TRUE;
RESET_CONO;
AEF←ARM_EXECUTE←FALSE;
PUSH_FORMAT(10,4);
ARM_SEGMENT←0;
ARM_MOTION←0;
FAST←TRUE;
FOR I←0 STEP 1 UNTIL '37 DO BANDS[I]←NULL;
NEXT_BAND←0;
STOP_ON_TOUCH←FALSE;
FOR I←1 STEP 1 UNTIL 6 DO MMOVE(A[SQAR(I)],A[SQAR(I)]);

MMOVE(Q[0],Q[0]);
MMOVE(Q[17],Q[17]);
FOR I←1 STEP 1 UNTIL 3 DO DEPART_ARM[I]←ARRIVE_ARM[I]←IF I=3 THEN 3.0 ELSE 0.0;
DEPART_ARM[4]←ARRIVE_ARM[4]←1.0;
FOR I←1 STEP 1 UNTIL 6 DO BEGIN
	N←SQAR(I);
	MMOVE(JMAT[N],JMAT[N])END ;
HANDPOS(V0);
ARRBLT(PARK_TRANS[1,1],T[SQAR(6)],16);
DO BEGIN
ARM_POSITION;
IF ARM_STATUS THEN
IFC WAVE THENC
BEGIN	OUTSTR(ERRORS&"
TYPE Y TO START FROM PARK ELSE CHECK PDP-6 AND TYPE C/R"&CRLF);
ELSEC
BEGIN	OUTSTR(CVOS(ARM_STATUS)&"
TYPE Y TO START FROM PARK ELSE CHECK PDP-6 AND TYPE C/R"&CRLF);
ENDC
	S←INCHWL;
	IF S="Y" THEN BEGIN
		ARRTRAN(ARM_VECTOR,V0);
		ARM_VECTOR[7]←0;
		UPDATE_SEG;
		ARM_STATUS←0 END;
END;
END UNTIL ¬ARM_STATUS;
ARRTRAN(LAST_ARM,ARM_VECTOR);
WAIT←"O.K.";
SPACES←"                                                        ";
GDISP_INIT←0;
OPEN(TTY,"TTY",0,2,0,120,BREAK,EOF);
EDIT_NAME←LFILE←FILE←NULL;
WAS_FORCED←TRUE;
FREEL←0;
FOR I←0 STEP 1 UNTIL 15 DO LLAB[I]←1;
OFILE←"YELLOW";
SETBREAK(ONE_LINE,'12&ALT_MODE,'14&'15,"IN");
SETBREAK(SOME,"0123456789.@+-;$ABCDEFGHIJKLMNOPQRSTUVWXYZ",NULL,"ILRD");
SETBREAK(SOMETHING,"0123456789.@+-;$ABCDEFGHIJKLMNOPQRSTUVWXYZ"&'12,'15,"ILRD");
SETBREAK(HEAD,"$;ABCDEFGHIJKLMNOPQRSTUVWXYZ",NULL,"ILRD");
SETBREAK(ID,"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_",NULL,"XN");
SETBREAK(RSB,"]",NULL,"IAN");
SETBREAK(DEL,"()[] ,;:	",NULL,"IN");
SETBREAK(NUMS,"0123456789.@+-$;",NULL,"ILR");
SETBREAK(NNUMS,"$0123456789.@+-",NULL,"XL");
SETBREAK(DOLLAR,"$",NULL,"I");
SETBREAK(LN,"	",NULL,"IA");
SETBREAK(FF,'14,NULL,"I");
SETBREAK(SEMI,";",NULL,"IR");
NMASK←'777777774000;
CHAN←TTY;
FMN←MAC←MAC_EOF←EOF←MAC_FREE←0;
FUNNUM[INTERN("DO",FUNNAM)]←0;
FUNNUM[INTERN("REQUIRE",FUNNAM)]←1;
FUNNUM[INTERN("TRANS",FUNNAM)]←2;
FUNNUM[INTERN("VECT",FUNNAM)]←3;
FUNNUM[INTERN("BEGIN",FUNNAM)]←4;
FUNNUM[INTERN("PARK",FUNNAM)]←5;
FUNNUM[INTERN("MOVE",FUNNAM)]←6;
FUNNUM[INTERN("STEP",FUNNAM)]←7;
FUNNUM[INTERN("DRAW",FUNNAM)]←8;
FUNNUM[INTERN("FREE",FUNNAM)]←9;
FUNNUM[INTERN("SPIN",FUNNAM)]←10;
FUNNUM[INTERN("FORCE",FUNNAM)]←11;
FUNNUM[INTERN("STOP",FUNNAM)]←12;
FUNNUM[INTERN("OPEN",FUNNAM)]←13;
FUNNUM[INTERN("SKIPE",FUNNAM)]←14;
FUNNUM[INTERN("JUMP",FUNNAM)]←15;
FUNNUM[INTERN("CLOSE",FUNNAM)]←16;
FUNNUM[INTERN("CENTER",FUNNAM)]←17;
FUNNUM[INTERN("PLACE",FUNNAM)]←18;
FUNNUM[INTERN("CHANGE",FUNNAM)]←19;
FUNNUM[INTERN("DRIVE",FUNNAM)]←20;
FUNNUM[INTERN("WAIT",FUNNAM)]←21;
FUNNUM[INTERN("MERGE",FUNNAM)]←22;
FUNNUM[INTERN("SAVE",FUNNAM)]←23;
FUNNUM[INTERN("RESTORE",FUNNAM)]←24;
FUNNUM[INTERN("TOUCH",FUNNAM)]←25;
FUNNUM[INTERN("CONO",FUNNAM)]←26;
FUNNUM[INTERN("END",FUNNAM)]←27;
FUNNUM[INTERN("FLUSH",FUNNAM)]←28;
FUNNUM[INTERN("P",FUNNAM)]←29;
FUNNUM[INTERN("ASSERT",FUNNAM)]←30;
FUNNUM[INTERN("FILE",FUNNAM)]←31;
FUNNUM[INTERN("I",FUNNAM)]←32;
FUNNUM[INTERN("DEPART",FUNNAM)]←33;
FUNNUM[INTERN("LINK",FUNNAM)]←34;
FUNNUM[INTERN("GRASP",FUNNAM)]←35;
FUNNUM[INTERN("LISTEN",FUNNAM)]←36;
FUNNUM[INTERN("WOBBLE",FUNNAM)]←37;
FUNNUM[INTERN("WHERE",FUNNAM)]←38;
FUNNUM[INTERN("HERE",FUNNAM)]←38;
FUNNUM[INTERN("SKIPN",FUNNAM)]←39;
FUNNUM[INTERN("SKIPS",FUNNAM)]←40;
FUNNUM[INTERN("DEFINE",FUNNAM)]←41;
FUNNUM[INTERN("DUMP",FUNNAM)]←42;
FUNNUM[INTERN("SET",FUNNAM)]←43;
FUNNUM[INTERN("ED",FUNNAM)]←44;
FUNNUM[INTERN("NNUL",FUNNAM)]←45;
FUNNUM[INTERN("SEARCH",FUNNAM)]←46;
FUNNUM[INTERN("AOJ",FUNNAM)]←47;
FUNNUM[INTERN("GO",FUNNAM)]←48;
FUNNUM[INTERN("GOTO",FUNNAM)]←6;
FUNNUM[INTERN("SCREW",FUNNAM)]←49;
FUNNUM[INTERN("MOVING",FUNNAM)]←50;
FUNNUM[INTERN("ASSIGN",FUNNAM)]←51;
FUNNUM[INTERN("SOJG",FUNNAM)]←52;
IFC THROWING THENC
	FUNNUM[INTERN("THROW",FUNNAM)]←53;
	FUNNUM[INTERN("TOSS",FUNNAM)]←54;
	IFC GRAPHICS THENC FUNNUM[INTERN("DISP",FUNNAM)]←55;ENDC
ELSEC IFC GRAPHICS THENC FUNNUM[INTERN("DISP",FUNNAM)]←53;ENDC ENDC
VECTNUM[INTERN("X",VECTNAM)]←1;
VECTNUM[INTERN("Y",VECTNAM)]←2;
VECTNUM[INTERN("Z",VECTNAM)]←3;
VECTNUM[INTERN("NIL",VECTNAM)]←0;
FREE_DATA←4;
OUTSTR("DO YOU WANT THE FILES SAVED?
");
IF INCHWL THEN FAST←FALSE;
OUTSTR("I AM CURIOUS YELLOW
");
IFC THROWING THENC OUTSTR("AND CAN THROW VERY MELLOW
"); ENDC
IFC ¬WAVE THENC
PUT_DATA(0,0,"HAND");
YES_HAND←-1;
ENDC
GO TO GET1;

GET:SIMIO(ONE_LINE);
GET1:SETFORMAT(10,2);
GGET:
IF AEF ∧ ARM_STATUS THEN BEGIN
OUTSTR(ERRORS&CRLF);
MAC_FREE←MAC←MAC_EOF←0;
FOR CHAN←CHAN STEP -1 UNTIL 2 DO RELEASE(CHAN);
END;
IF ¬MAC ∧ CHAN=1 THEN OUTSTR("*"&CRLF);
AEF←FALSE;
I←GETNAME(FALSE,S,FUNNAM);
IF CHAN>1 ∧ EQU(S,"COMMENT") THEN BEGIN
	DO INPUT(CHAN,FF) UNTIL BREAK='14;
	GO TO GGET END;
IF LENGTH(FUNNAM[I]) THEN EXETRUE:CASE FUNNUM[I] OF BEGIN

BEGIN "DOIT"
	INTEGER J;
	STRING PS,PN;
	J←0;
	ARM_EXECUTE←AEF←TRUE;
	IF BREAK≠'15
	THEN BEGIN I←GETNAME(FALSE,S,FUNNAM);
		IF LENGTH(FUNNAM[I]) THEN GO TO EXETRUE;
		LFILE←S;
		IF BREAK="[" 
		THEN BEGIN SL←SIMIO(RSB);
			PS←SCAN(SL,DEL,BREAK);
			PS←SPACES[1 FOR (3-LENGTH(PS))]&PS;
			PN←SCAN(SL,DEL,BREAK);
			PN←SPACES[1 FOR (3-LENGTH(PN))]&PN;
			J←CVSIX(PS&PN) END END
	ELSE S←LFILE;
	SAY_WAIT;
	IF LENGTH(FILE) THEN BEGIN 
		CLOSE_TRAJECTORY;
		FILE←NULL;
	END;
	DO_IT(J,S);
	GO TO GET1;
END"DOIT";

BEGIN "REQUIRE"
	SIMIO(HEAD);
	FILE_NAME[CHAN+1]←(S←SIMIO(ID))&'11;
	IF BREAK="." THEN S←S&"."&SIMIO(ID) ELSE S←S&".HAL";
	IF BREAK="[" THEN S←S&"["&SIMIO(RSB);
	OPEN(CHAN+1,"DSK",0,2,0,120,BREAK,EOF);
	LOOKUP(CHAN+1,S,EOF);
	IF EOF≠0 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&"	"&LINE_NO&"FILE NOT FOUND"&CRLF);
	RELEASE(CHAN+1);GO TO GET END;
	CHAN←CHAN+1;
	GO TO GET1;
END "REQUIRE";


BEGIN "TRANS"
	INTEGER PTR;
	SAFE OWN REAL ARRAY E[1:6];
	SAFE OWN REAL ARRAY VT,VTT[1:4];
	PTR←GETNAME(FALSE,S,TRANSNAM);
	IF ¬LENGTH(TRANSNAM[PTR])
	THEN BEGIN
		IF FREE_DATA+2>FREE_DATA_LENGTH
		THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE DATA"&CRLF);GO TO GET END;
		TRANSNAM[PTR]←S;
		TRANSNUM[PTR]←FREE_DATA;
		ARRBLT(E[1],ANEW[1],6);
		FREE_DATA←FREE_DATA+2 END
	ELSE ARRBLT(E[1],DATA_BASE[TRANSNUM[PTR],1],6);
	IF ¬MAC ∧ CHAN=1 THEN BEGIN SIMIO(ONE_LINE);
	        OUTSTR("       X         Y         Z         O         A         T"&CRLF);
		WHILE TRUE DO BEGIN
	     FOR I←1 STEP 1 UNTIL 6 DO OUTSTR(CVF(E[I]));
	     OUTSTR(CRLF&"CHANGE?"&CRLF);
		S←SIMIO(ONE_LINE);
		IF ¬LENGTH(S) THEN DONE;
		FOR I←1 STEP 1 UNTIL 6 DO
		IF LENGTH(S) THEN BEGIN
		SL←SCAN(S,DEL,IFI);
		R←REALSCAN(SL,IFI);
		IF IFI≠-1 THEN E[I]←R;
	END;
	END;
	END ELSE FOR I←1 STEP 1 UNTIL 6 DO BEGIN
		GETNAME(TRUE,S,VECTNAM);
		E[I]←REALSCAN(S,BREAK) END;
	ARRBLT(DATA_BASE[TRANSNUM[PTR],1],E[1],6);
	GO TO GET1;
END"TRANS";

BEGIN "VECT"
	INTEGER PTR;
	PTR←GETNAME(FALSE,S,VECTNAM);
	IF ¬LENGTH(VECTNAM[PTR])
	THEN BEGIN
		IF FREE_DATA+1>FREE_DATA_LENGTH
		THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE DATA"&CRLF);GO TO GET END;
		VECTNAM[PTR]←S;
		VECTNUM[PTR]←FREE_DATA;
		FOR I←1 STEP 1 UNTIL 3 DO XV[I]←0;
		FREE_DATA←FREE_DATA+1 END
	ELSE ARRBLT(XV[1],DATA_BASE[VECTNUM[PTR],1],3);
	XV[4]←1;
	IF ¬MAC ∧ CHAN=1 THEN BEGIN
		   SIMIO(ONE_LINE);
		   WHILE TRUE DO BEGIN PVECT(NULL,XV);
	           OUTSTR("CHANGE ?"&CRLF);
		   S←SIMIO(ONE_LINE);
		   IF ¬LENGTH(S) THEN DONE;
	   	   FOR I←1 STEP 1 UNTIL 3 DO
		   IF LENGTH(S) THEN BEGIN
			SL←SCAN(S,DEL,IFI);
			R←REALSCAN(SL,IFI);
			IF IFI≠-1 THEN XV[I]←R;
		END;
	END;
	END ELSE FOR I←1 STEP 1 UNTIL 3 DO BEGIN
		GETNAME(TRUE,S,VECTNAM);
		XV[I]←REALSCAN(S,BREAK) END;
	ARRBLT(DATA_BASE[VECTNUM[PTR],1],XV[1],3);
	GO TO GET1;
END "VECT";

BEGIN "BEGIN"
	IF FILE THEN  CLOSE_TRAJECTORY ;
	GETNAME(FALSE,LFILE,VECTNAM);
	FILE←LFILE;
	SAY_WAIT;
	START_TRAJECTORY(FILE,0);
END"BEGIN";

BEGIN "PARK"
	SAY_WAIT;
	OPEN_ONE;
	PARK_ARM;
END"PARK";

BEGIN "MOVE"
	REAL DIST,DEG;
	BOOLEAN GOM;
	GOM←EQU(S,"GOTO");
	IF READT(TT1,S,"MOVE - "&S&" TRANSFORM DOSN'T EXIST")
	THEN BEGIN SIMIO(SOMETHING);
		IF BREAK≠'12 ∧ BREAK≠";" THEN BEGIN
		IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
		GETNAME(TRUE,S,FUNNAM);
		DIST←REALSCAN(S,BREAK);
		IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
		GETNAME(TRUE,S,FUNNAM);
		DEG←REALSCAN(S,BREAK);
		SCALE(XV,XV,DIST);
		REDUCE(XV);
		XV[1]←XV[1]*TSX;XV[2]←XV[2]*TSY;
		FOR J←1 STEP 1 UNTIL 3 DO TT1[J,4]←TT1[J,4]+XV[J];
		IF DEG ∧ MAGNITUDE(YV) THEN BEGIN
			FOR I←1 STEP 1 UNTIL 3 DO BEGIN
				CVV(XV,TT1,I);
				REVOLVE(XV,YV,DEG);
				CVC(TT1,I,XV) END;
			END;
		END;
		SAY_WAIT;
		OPEN_ONE;
		IF GOM THEN GO_ARM(TT1,ARM_PLAN) ELSE MOVE_ARM(TT1,ARM_PLAN);
		IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNABLE TO MOVE"&CRLF)END
END"MOVE";

BEGIN"STEP"
IFC WAVE THENC
	GETNAME(TRUE,S,FUNNAM);
	I←INTSCAN(S,BREAK);
	GETNAME(TRUE,S,FUNNAM);
	R←REALSCAN(S,BREAK);
	GETNAME(TRUE,S,FUNNAM);
	J←INTSCAN(S,BREAK);
	SAY_WAIT;
	OPEN_ONE;
	IF 1≤ I ≤6 THEN STEP_ARM(I,R,J) ELSE OUTSTR(FILE_NAME[CHAN]&LINE_NO&"SORRY"&CRLF);
ELSEC
OUTSTR("RUN YELLOW FOR STEP"&CRLF);
ENDC
END"STEP";

BEGIN "DRAW"
	INTEGER I;
	SAFE OWN REAL ARRAY PROFILE[0:5,1:4];
	SAFE OWN REAL ARRAY DP[1:4];
	EXTERNAL SIMPLE PROCEDURE MOVEV(REFERENCE REAL R;REAL ARRAY S);
	IF ¬MAC ∧ CHAN=1 THEN BEGIN OUTSTR("POSITION,ROTATION,ANGLE
CRANK,AXIS,DEGREES
TIME,LOOP"&CRLF);
	SIMIO(ONE_LINE) END;
	IF ¬READV(XV,S,"NEW POSITION MISSING") THEN GO TO GET;
	MOVEV(DP[1],XV);
	REDUCE(DP);
	DP[1]←DP[1]*TSX;
	DP[2]←DP[2]*TSY;
	MOVEV(PROFILE[1,1],DP);
	IF ¬READV(YV,S,"ROTATION AXIS MISSING") THEN GO TO GET;
	MOVEV(PROFILE[2,1],YV);
	GETNAME(TRUE,S,FUNNAM);
	PROFILE[3,1]←REALSCAN(S,BREAK);
	IF ¬(READV(XV,S,"CRANK MISSING") ∧ READV(YV,S,"AXIS MISSING"))THEN GO TO GET;
	GETNAME(TRUE,S,FUNNAM);
	PROFILE[3,2]←REALSCAN(S,BREAK);
	MOVEV(PROFILE[4,1],XV);
	MOVEV(PROFILE[5,1],YV);
	GETNAME(TRUE,S,FUNNAM);
	PROFILE[0,2]←INTSCAN(S,BREAK);
	GETNAME(TRUE,S,FUNNAM);
	PROFILE[0,3]←INTSCAN(S,BREAK);
	IF PROFILE[0,3] ∧ ¬(ABS(PROFILE[3,2])=360 ∨ ABS(PROFILE[3,1])=360)
	THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNLOOPABLE
"); GO TO GET END;
	SAY_WAIT;
	OPEN_ONE;
	DRAW_ARM(PROFILE,ARM_PLAN);
	IF ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"DRAW - SORRY"&CVOS(ARM_PLAN)&CRLF);
END"DRAW";


BEGIN"FREE"
	GETNAME(TRUE,S,FUNNAM);
	J←INTSCAN(S,BREAK);
	FOR I←FREE_ARM[0,1]+1 STEP 1 UNTIL FREE_ARM[0,1]+J DO
	BEGIN
		FREE_ARM[I,1]←0;ARRBLT(FREE_ARM[I,2],FREE_ARM[I,1],5);
		IF READV(XV,S,"MISSING FREE")
		THEN BEGIN REDUCE(XV);
			ARRBLT(FREE_ARM[I,1],XV[1],3)END;
	END;
	FREE_ARM[0,1]←FREE_ARM[0,1]+J;
END"FREE";

BEGIN"SPIN"
	GETNAME(TRUE,S,FUNNAM);
	J←INTSCAN(S,BREAK);
	FOR I←FREE_ARM[0,1]+1 STEP 1 UNTIL FREE_ARM[0,1]+J DO
	BEGIN
		FREE_ARM[I,1]←0;ARRBLT(FREE_ARM[I,2],FREE_ARM[I,1],5);
		IF READV(XV,S,"MISSING FREE")
		THEN BEGIN REDUCE(XV);
			ARRBLT(FREE_ARM[I,4],XV[1],3)END;
	END;
	FREE_ARM[0,1]←FREE_ARM[0,1]+J;
END"SPIN";

BEGIN"FORCE"
	IF (READV(XV,S,"MISSING FORCE") ∧ READV(YV,S,"MISSING MOMENT"))
	THEN BEGIN REDUCE(XV);
		ARRBLT(FORCE_ARM[1],XV[1],3);
		REDUCE(YV);
		ARRBLT(FORCE_ARM[4],YV[1],3) END;
END"FORCE";

BEGIN "STOP"
	IF (READV(XV,S,"MISSING FORCE") ∧ READV(YV,S,"MISSING MOMENT"))
	THEN BEGIN SAY_WAIT;
		OPEN_ONE;
		STOP_ARM(XV,YV) END;
END"STOP";

BEGIN"OPEN_HAND"
	GETNAME(TRUE,S,FUNNAM);
	R←REALSCAN(S,BREAK);
	SAY_WAIT;
	OPEN_ONE;
	OPEN_HAND(R);
END"OPEN_HAND";

BEGIN"SKIPE"
	STRING SL;
	SL←SIMIO(ONE_LINE);
	I←CVO(SL);
	SAY_WAIT;
	ARM_SKIPE(I);
	GO TO GET1
END"SKIPE";

BEGIN"JUMP"
	STRING SC;
	CODE_LINE[PTR3+1]←LINE_NO;
	S←SC←SIMIO(ONE_LINE);
	SCAN(SC,HEAD,J);
	IF LENGTH(REF[PTR3+1]←SCAN(SC,ID,J))
	THEN BEGIN SC←BREAK&SC;
		I←INTSCAN(SC,J) END ELSE I←INTSCAN(S,J);
	SAY_WAIT;
	OPEN_ONE;
	ARM_JMP(I);
	GO TO GET1;
END"JUMP";

BEGIN "CLOSE_HAND"
	GETNAME(TRUE,S,FUNNAM);
	R←REALSCAN(S,BREAK);
	SAY_WAIT;
	OPEN_ONE;
	CLOSE_HAND(R);
END"CLOSE_HAND";

BEGIN "CENTER"
	GETNAME(TRUE,S,FUNNAM);
	R←REALSCAN(S,BREAK);
	SAY_WAIT;
	OPEN_ONE;
	CENTER_HAND(R);
END"CENTER";

BEGIN "PLACE"
	SAY_WAIT;
	OPEN_ONE;
	PLACE_ARM;
END"PLACE";

BEGIN"CHANGE"
	REAL DIST,DEG;
	INTEGER TIME;
	OPEN_ONE;
	IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
	GETNAME(TRUE,S,FUNNAM);
	DIST←REALSCAN(S,BREAK);
	IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
	GETNAME(TRUE,S,FUNNAM);
	DEG←REALSCAN(S,BREAK);
	GETNAME(TRUE,S,FUNNAM);
	TIME←INTSCAN(S,BREAK);
	SAY_WAIT;
	CHANGE_ARM(XV,DIST,YV,DEG,TIME,ARM_PLAN);
	IF ¬ARM_PLAN  THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"CAREFUL"&CRLF);
END"CHANGE";

BEGIN"DRIVE"
	GETNAME(TRUE,S,FUNNAM);
	I←INTSCAN(S,BREAK);
	GETNAME(TRUE,S,FUNNAM);
	R←REALSCAN(S,BREAK);
	GETNAME(TRUE,S,FUNNAM);
	J←INTSCAN(S,BREAK);
	SAY_WAIT;
	OPEN_ONE;
	DRIVE_ARM(I,R,J,ARM_PLAN);
	IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"SORRY"&CRLF);
END"DRIVE";

BEGIN"WAIT"
	S←SIMIO(ONE_LINE);
	IF LENGTH(S) THEN S←S&'15&'12;
	SAY_WAIT;
	WAIT_ARM(S);
	GO TO GET1;
END"WAIT";

BEGIN"MERGE"
	SAY_WAIT;
	MERGE_ARM;
END"MERGE";

BEGIN"SAVE"
	LABEL L1;
	GETNAME(FALSE,S,VECTNAM);
L1:	SAY_WAIT;
	OPEN_ONE;
	ARM_SAVE(S);
END"SAVE";

BEGIN"RESTORE"
	LABEL L1;
	INTEGER I;
	STRING SL;
	GETNAME(FALSE,S,VECTNAM);
L1:	GETNAME(TRUE,SL,FUNNAM);
	I←INTSCAN(SL,BREAK);
	SAY_WAIT;
	OPEN_ONE;
	ARM_RESTORE(S,I);
END"RESTORE";

BEGIN "TOUCH"
	GETNAME(TRUE,S,FUNNAM);
	I←INTSCAN(S,BREAK);
	SAY_WAIT;
	OPEN_ONE;
	SET_TOUCH(I);
END"TOUCH";

BEGIN"CONO"
	IF (READV(XV,S,"APPROACH DOES NOT EXIST")
	∧ READV(ZV,S,"OBJECT DOES NOT EXIST"))
	THEN BEGIN
		GETNAME(TRUE,S,FUNNAM);
		ZV[4]←REALSCAN(S,BREAK);
		GETNAME(TRUE,S,FUNNAM);
		I←INTSCAN(S,BREAK);
		GETNAME(TRUE,S,FUNNAM);
		J←INTSCAN(S,BREAK);
		SAY_WAIT;
		ARM_CONO(XV,ZV,I,J);
	END;
END "CONO";

BEGIN"END"
	SAY_WAIT;
	IF LENGTH(FILE) THEN CLOSE_TRAJECTORY;
	FILE←NULL;
END"END";

IF LENGTH(FILE) THEN FLUSH(0,LAST_ARM);

BEGIN "PROCEED"
	S←SIMIO(ONE_LINE);
	I←INTSCAN(S,BREAK);
	SAY_WAIT;
	DO_PROCEED(I);
	AEF←TRUE;
	GO TO GET1;
END"PROCEED";

BEGIN"ASSERT"
	IF ¬READT(XT,S,"ASSERT- "&S&" TRANSFORM DOSN'T EXIST") THEN GO TO GET;
	ARRTRAN(LAST_TRANS,XT);
	ARRTRAN(LAST_PLANNED_TRANS,XT);
	ARM_SOLVE(XT,LAST_ARM,I);
	ARRTRAN(LAST_PLANNED_ARM,LAST_ARM);
END"ASSERT";

BEGIN"FILE"
	GETNAME(FALSE,OFILE,VECTNAM);
END"FILE";

BEGIN"I"
	IF ¬MAC ∧ CHAN=1 THEN FOR I←1 STEP 1 UNTIL 6 DO OUTSTR(CVF(ARM_VECTOR[I]));
	IF ¬MAC ∧ CHAN=1 THEN OUTSTR(CRLF);
END"I";

BEGIN "DEPART"
	IF ¬READV(YV,S,"DEPART DOSN'T EXIST")THEN GO TO GET;
	ARRTRAN(DEPART_ARM,YV);
END "DEPART";

BEGIN"LINK"
	SAFE OWN REAL ARRAY T[1:4,1:4];
	GETNAME(TRUE,S,FUNNAM);
	I←INTSCAN(S,BREAK);
	IF I<3 ∨ I>6 THEN BEGIN OUTSTR("THAT LINK IS NOT AVAILABLE"&CRLF);GO TO GET END;
	ARRBLT(T[1,1],ARM_LINK[I,1,1],16);
	T[1,4]←T[1,4]/TSX;
	T[2,4]←T[2,4]/TSY;
	PMAT(NULL,T);
END"LINK";

OUTSTR(CVF(GRASP)&CRLF);

BEGIN"LISTEN"
	INTERP←FALSE;
	SAY_WAIT;
IFC WAVE THENC OUTSTR("RUN HANDY FOR LISTEN"&CRLF);
ELSEC	WHILE ¬INTERP DO QUEUE('600, GET_ENTRY('120,NULL,"HAND",NULL));
ENDC
END;"LISTEN"

BEGIN"WOBBLE"
	GETNAME(TRUE,S,FUNNAM);
	R←REALSCAN(S,BREAK);
	SAY_WAIT;
	OPEN_ONE;
	WOBBLE_HAND(R);
END"WOBBLE";

BEGIN "POS"
	SAFE OWN REAL ARRAY T[1:4,1:4];
	STRING NN;
	INTEGER I,PTR,IFI,J;
	SAFE OWN REAL ARRAY TV[1:4];
	SAFE OWN REAL ARRAY E[1:6];
	LABEL JP;
	REAL DEG,DIST,R;
	BOOLEAN HC,GOM;
	ARM_POSITION;
	AEF←TRUE;
	ARRBLT(T[1,1],ARM_LINK[6,1,1],16);
	IF GOM←EQU(S,"HERE") THEN BEGIN
		PTR←GETNAME(FALSE,NN,TRANSNAM);
		SIMIO(SOMETHING);
		IF BREAK≠'12 ∧ BREAK≠";" THEN BEGIN
		IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
		HC←0;
		GETNAME(TRUE,S,FUNNAM);
		DIST←REALSCAN(S,BREAK);
		IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
		GETNAME(TRUE,S,FUNNAM);
		DEG←REALSCAN(S,BREAK);
		SCALE(XV,XV,DIST);
		REDUCE(XV);
		XV[1]←XV[1]*TSX;XV[2]←XV[2]*TSY;
		IF DEG ∧ MAGNITUDE(YV) THEN BEGIN
			IF HC THEN REVOLVE(XV,YV,-DEG);
			FOR I←1 STEP 1 UNTIL 3 DO BEGIN
				CVV(TV,T,I);
				REVOLVE(TV,YV,-DEG);
				CVC(T,I,TV) END;
			END;
		FOR J←1 STEP 1 UNTIL 3 DO T[J,4]←T[J,4]-XV[J];
	END;
	END;
	SAY_WAIT;
	UNSTRUCT(T,E);
	IF GOM THEN BEGIN
	IF ¬LENGTH(TRANSNAM[PTR])
	THEN BEGIN
		IF FREE_DATA+2>FREE_DATA_LENGTH
		THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE DATA"&CRLF);
			GOM←FALSE;
			GO TO JP END;
		TRANSNAM[PTR]←NN;
		TRANSNUM[PTR]←FREE_DATA;
		FREE_DATA←FREE_DATA+2 END;END;
JP:	IF ¬MAC ∧ CHAN=1 THEN BEGIN
	SIMIO(ONE_LINE);
	        OUTSTR("       X         Y         Z         O         A         T"&CRLF);
		WHILE TRUE DO BEGIN
	     FOR I←1 STEP 1 UNTIL 6 DO OUTSTR(CVF(E[I]));
	     IF ¬GOM THEN BEGIN OUTSTR(CRLF);GO TO GET1 END;
	     OUTSTR(CRLF&"CHANGE?"&CRLF);
		S←SIMIO(ONE_LINE);
		IF ¬LENGTH(S) THEN DONE;
		FOR I←1 STEP 1 UNTIL 6 DO
		IF LENGTH(S) THEN BEGIN
		SL←SCAN(S,DEL,IFI);
		R←REALSCAN(SL,IFI);
		IF IFI≠-1 THEN E[I]←R;
	END;
	END;
	ARRBLT(DATA_BASE[TRANSNUM[PTR],1],E[1],6) END;
	GO TO GET1;
END "POS";

BEGIN"SKIPN"
	STRING SL;
	SL←SIMIO(ONE_LINE);
	I←CVO(SL);
	SAY_WAIT;
	ARM_SKIPN(I);
	GO TO GET1
END"SKIPN";

BEGIN"SKIPS"
	STRING SL;
	SL←SIMIO(ONE_LINE);
	I←CVO(SL);
	SAY_WAIT;
	ARM_SKIPS(I);
	GO TO GET1
END"SKIPS";

BEGIN "DEFINE"
	STRING ARRAY ARG[1:10];
	INTEGER TMN;
	I←GETNAME(FALSE,S,FUNNAM);
	IF LENGTH(FUNNAM[I]) THEN OUTSTR(S&" MACRO NAME RESERVED WORD"&CRLF);
	FOR TMN←1 STEP 1 UNTIL FMN DO IF EQU(S,MACRO_NAME[TMN]) THEN DONE;
	IF TMN>MAX_MACRO THEN BEGIN OUTSTR("SORRY, TOO MANY MACROS
"); GO TO GET END;
	IF TMN>FMN THEN MACRO_NAME[TMN]←S;
	MACRO_FORMAL[TMN]←S←SIMIO(ONE_LINE);
	J←0;
	WHILE LENGTH(S)
	DO BEGIN SCAN(S,HEAD,BREAK);
		IF BREAK=";" THEN DONE;
		SL←SCAN(S,ID,BREAK);
		IF LENGTH(SL) THEN ARG[J←J+1]←SL END;
	PUSH_FORMAT(0,0);
	MACRO_DEFN[TMN]←NULL;
	WHILE TRUE
	DO BEGIN
		IF ¬MAC ∧ CHAN=1 THEN OUTSTR("*");
		S←SIMIO(ONE_LINE);
		IF ¬LENGTH(S) THEN DONE;
		WHILE LENGTH(S) DO BEGIN
		SCAN(S,SOME,BREAK);
		IF "A" ≤ BREAK ≤ "Z"
		THEN BEGIN SL←SCAN(S,ID,BREAK);
			FOR I←1 STEP 1 UNTIL J
			DO IF EQU(SL,ARG[I])
			   THEN BEGIN SL←"$"&CVS(I);
				DONE END;
			IF BREAK=":" THEN SL←SL&":";
			IF BREAK="+" ∨ BREAK="-" THEN S←BREAK&S END
		ELSE 
		IF BREAK = ";" THEN BEGIN SL←S;S←NULL END
		ELSE SL←SCAN(S,NNUMS,BREAK);
		IF EQU(SL,"-") THEN S←BREAK&S;
		MACRO_DEFN[TMN]←MACRO_DEFN[TMN]&SL&(IF LENGTH(S) ∧ ¬EQU(SL,"-") THEN " " ELSE NULL);
		END;
		MACRO_DEFN[TMN]←MACRO_DEFN[TMN]&'15&'12;
	END;
	POP_FORMAT;
	OUTSTR((EDIT_NAME←MACRO_NAME[TMN])&(IF TMN≤FMN THEN " REDEFINED" ELSE " DEFINED")&CRLF);
	IF TMN>FMN THEN FMN←TMN;
	GO TO GET1;
END "DEFINE";

BEGIN "DUMP"
	STRING SLPT,SA,SB,SC;
	LABEL AL,PM;
	INTEGER LINES,LTG;
	STRING ARRAY ARG[1:10];
	SIMIO(HEAD);
	S←SIMIO(ID);
	IF BREAK="." THEN S←S&"."&SIMIO(ID) ELSE S←S&".HAL";
	IF BREAK="[" THEN S←S&"["&SIMIO(RSB);
	OPEN(CHAN←CHAN+1,"DSK",0,0,3,120,BREAK,EOF);
	ENTER(CHAN,S,EOF);
	OUTSTR(WAIT&'15&'12);
	LINES←LTG←0;
	FOR I←0 STEP 1 UNTIL '77 DO
	IF LENGTH(TRANSNAM[I]) THEN BEGIN
	OUT(CHAN,"TRANS	"&TRANSNAM[I]&"	");
	ARRBLT(DIR[1],DATA_BASE[TRANSNUM[I],1],6);
	FOR J←1 STEP 1 UNTIL 6 DO OUT(CHAN,CVF(DIR[J]));
	OUT(CHAN,CRLF);
	LINES←LINES+1;
	IF LINES>50 THEN BEGIN OUT(CHAN,'14);LINES←0 END;
	END;
	IF LINES THEN BEGIN OUT(CHAN,CRLF&CRLF);LINES←LINES+2 END;
	S←NULL;
	FOR I←0 STEP 1 UNTIL '77 DO
	IF LENGTH(VECTNAM[I]) THEN BEGIN
	S←S&"VECT	"&VECTNAM[I]&"	";
	ARRBLT(DIR[1],DATA_BASE[VECTNUM[I],1],3);
	FOR J←1 STEP 1 UNTIL 3 DO S←S&CVF(DIR[J]);
	S←S&CRLF;
	LTG←LTG+1;
	IF LINES ∧ LINES+LTG>50 THEN BEGIN LINES←0; OUT(CHAN,'14) END;
	IF LTG>50 THEN BEGIN OUT(CHAN,S&'14);LTG←0;S←NULL END;
	END;
	IF LTG THEN OUT(CHAN,S);
	IF FMN THEN OUT(CHAN,'14);
	LINES←LTG←0;
	SLPT←NULL;
	FOR I←1 STEP 1 UNTIL FMN DO BEGIN
	PM: SLPT←"DEFINE	"&MACRO_NAME[I]&"	";
	SA←MACRO_FORMAL[I];
	SB←SCAN(SA,SEMI,BREAK);
	J←0;
	SC←NULL;
	WHILE LENGTH(SB)
	DO BEGIN SCAN(SB,HEAD,BREAK);
		SL←SCAN(SB,ID,BREAK);
		IF LENGTH(SL) THEN SC←SC&(ARG[J←J+1]←SL)&" " END;
	SLPT←SLPT&SC;
	LTG←1;
	IF LENGTH(SA) THEN SLPT←SLPT&SPACES[1 FOR (16-LENGTH(SC))]&SA;
	SLPT←SLPT&CRLF;
	S←MACRO_DEFN[I];
	WHILE LENGTH(S) DO BEGIN
	SA←SCAN(S,ONE_LINE,BREAK);
	SB←SCAN(SA,SEMI,BREAK);
	SC←NULL;
	WHILE LENGTH(SB) DO BEGIN
	SC←SC&SCAN(SB,DOLLAR,BREAK);
	IF LENGTH(SB) THEN SC←SC&ARG[INTSCAN(SB,BREAK)];
	END;
	SLPT←SLPT&SC;
	IF LENGTH(SA) THEN SLPT←SLPT&SPACES[1 FOR (32 - LENGTH(SC))]&SA;
	SLPT←SLPT&CRLF;
	AL: LTG←LTG+1;
	IF LINES ∧ LINES+LTG>50 THEN BEGIN OUT(CHAN,'14);LINES←0 END;
	IF LTG>50 THEN BEGIN OUT(CHAN,SLPT&'14);SLPT←NULL;LTG←0 END;
	END;
	IF LTG THEN BEGIN OUT(CHAN,SLPT&CRLF);
		LINES←LINES+LTG+1;
		LTG←0 END;
	END;
	RELEASE(CHAN);
	CHAN←CHAN-1;
END "DUMP";

BEGIN"SET"
	GETNAME(FALSE,SL,VECTNAM);
	IF ¬READT(XT,S,"FRAME DOESN'T EXIST") THEN GO TO GET;
	IF ¬READT(TT1,S,"WRT DOESN'T EXIST") THEN GO TO GET;
	SAY_WAIT;
	OPEN_ONE;
	SET_ARM(SL,XT,TT1);
END"SET";

BEGIN "EDIT"
STRING SC,SO,SN,SS;
INTEGER REP;
BOOLEAN ALT;
STRING ARRAY ARG[1:10];
PROCEDURE LINED(REFERENCE STRING S;REFERENCE BOOLEAN ALT);
BEGIN STRING ST,SE;
	LABEL L1,L2;
	SE←S;
	S←NULL;
L1:	IF (REP←REP-1)≤0 THEN BEGIN
	IF SC="F" THEN BEGIN ST←SE;
		S←SCAN(ST,ONE_LINE,I);
		WHILE LENGTH(S) DO BEGIN SCAN(S,SOME,I);
		IF EQU(SS,SCAN(S,DEL,I)) THEN BEGIN S←NULL;GO TO L2 END END;
		S←SE;
		RETURN END;
L2:	OUTSTR(SE&"?");
	SC←INPUT(TTY,ONE_LINE);
	IF ALT←BREAK=ALT_MODE THEN BEGIN S←SE;RETURN END;
	ST←SCAN(SC,HEAD,BREAK);
	IF SC="E" THEN BEGIN REP←999;
		SC←NULL END
	ELSE REP←INTSCAN(ST,BREAK);
	END;
	IF SC="F" THEN BEGIN ST←SC[2 TO ∞];IF LENGTH(ST) THEN SS←ST END;
	IF SC="I" THEN BEGIN S←S&SE;OUTSTR("*");
	IF ¬(SE←INCHWL)THEN BEGIN OUTSTR("A BLANK LINE TRY AGAIN"&'15&'12&"*");
	SE←INCHWL END;
	SE←SE&'15&'12;GO TO L1 END;
	IF SC="Z" THEN BEGIN LODED(SE);
	IF ¬(SE←INCHWL)THEN BEGIN OUTSTR("A BLANK LINE TRY AGAIN"&'15&'12&"*");
	SE←INCHWL END;
	SE←SE&'15&'12;
		IF REP=1 THEN REP←0;
		IF ¬REP THEN GO TO L1 END;
	IF SC="T" THEN OUTSTR(SE);
	IF SC≠"D" THEN S←S&SE;
END;

IF BREAK≠'15 THEN GETNAME(FALSE,EDIT_NAME,FUNNAM);
FOR I←1 STEP 1 UNTIL FMN DO IF EQU(EDIT_NAME,MACRO_NAME[I]) THEN BEGIN
	SN←"DEFINE	"&MACRO_NAME[I]&"	"&MACRO_FORMAL[I]&"
";
	INPUT(TTY,ONE_LINE);
	MAC←MAC+1;
	REP←0;
	SS←SC←NULL;
	LINED(SN,ALT);
	J←0;
	S←MACRO_FORMAL[I];
	WHILE LENGTH(S)
	DO BEGIN SCAN(S,HEAD,BREAK);
		IF BREAK=";" THEN DONE;
		SL←SCAN(S,ID,BREAK);
		IF LENGTH(SL) THEN ARG[J←J+1]←SL END;
	S←MACRO_DEFN[I];
	SO←NULL;
	WHILE LENGTH(S) DO BEGIN
	SO←SO&SCAN(S,DOLLAR,BREAK);
	IF LENGTH(S) THEN SO←SO&ARG[INTSCAN(S,BREAK)];
	IF BREAK='12 THEN SO←SO&'15;
	END;
	WHILE LENGTH(SO) DO BEGIN LINED(S←SCAN(SO,ONE_LINE,BREAK)&"
",ALT);
		IF ALT THEN BEGIN
			OUTSTR('15&'12);
			SO←S&SO;
			S←SN;
			SN←SL←NULL;
			DO BEGIN SN←SN&SL;
				SL←SCAN(S,ONE_LINE,BREAK)&'15&'12 END
				UNTIL ¬LENGTH(S);
			SO←SL&SO END
		ELSE SN←SN&S END;
	MACRO_SOURCE[MAC]←SN;
	MAC_TOP[MAC]←MAC_FREE;
	BBEG[MAC]←PTR3+1;
	LLAB[MAC]←FREEL+1;
	OUTSTR('15&'12);
	GO TO GET1;
END;
END"EDIT";
BEGIN "NNUL" SAY_WAIT;NO_NULL END"NNUL";

BEGIN "SEARCH"
	GETNAME(TRUE,S,FUNNAM);
	R←REALSCAN(S,BREAK);
	IF ¬READV(XV,S,"NORMAL DOSN'T EXIST") THEN GO TO GET;
	IF ¬READV(YV,S,"FIRST DIRECTION DOSN'T EXIST") THEN GO TO GET;
	SAY_WAIT;
	OPEN_ONE;
	SEARCH_ARM(R,XV,YV);
END"SEARCH";

BEGIN"AOJ"
	STRING SC;
	CODE_LINE[PTR3+1]←LINE_NO;
	S←SC←SIMIO(ONE_LINE);
	SCAN(SC,HEAD,J);
	IF LENGTH(REF[PTR3+1]←SCAN(SC,ID,J))
	THEN BEGIN SC←BREAK&SC;
		I←INTSCAN(SC,J) END ELSE I←INTSCAN(S,J);
	SAY_WAIT;
	OPEN_ONE;
	ARM_AOJ(I);
	GO TO GET1;
END"AOJ";

BEGIN "TO"
	REAL DIST,DEG;
	IF READT(TT1,S,"TO - "&S&" TRANSFORM DOSN'T EXIST")
	THEN BEGIN SIMIO(SOMETHING);
		IF BREAK≠'12 ∧ BREAK≠";" THEN BEGIN
		IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
		GETNAME(TRUE,S,FUNNAM);
		DIST←REALSCAN(S,BREAK);
		IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
		GETNAME(TRUE,S,FUNNAM);
		DEG←REALSCAN(S,BREAK);
		SCALE(XV,XV,DIST);
		REDUCE(XV);
		XV[1]←XV[1]*TSX;XV[2]←XV[2]*TSY;
		FOR J←1 STEP 1 UNTIL 3 DO TT1[J,4]←TT1[J,4]+XV[J];
		IF DEG ∧ MAGNITUDE(YV) THEN BEGIN
			FOR I←1 STEP 1 UNTIL 3 DO BEGIN
				CVV(XV,TT1,I);
				REVOLVE(XV,YV,DEG);
				CVC(TT1,I,XV) END;
			END;
		END;
		SAY_WAIT;
		OPEN_ONE;
		TO_ARM(TT1,ARM_PLAN);
		IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNABLE TO MOVE"&CRLF)END
END"TO";

BEGIN"SCREW"
	GETNAME(TRUE,S,FUNNAM);
	R←REALSCAN(S,BREAK);
	SAY_WAIT;
	OPEN_ONE;
	SCREW(R);
END"SCREW";
BEGIN"MOVING"
	GETNAME(FALSE,SL,VECTNAM);
	IF ¬READV(XV,S,"VELOCITY DOESN'T EXIST") THEN GO TO GET;
	SAY_WAIT;
	OPEN_ONE;
	MOVING(SL,XV);
END"MOVING";

BEGIN"ASSIGN"
	STRING S;
	INTEGER VAL;
	GETNAME(FALSE,S,VECTNAM);
	GETNAME(TRUE,SL,VECTNAM);
	VAL←INTSCAN(SL,BREAK);
	SAY_WAIT;
	OPEN_ONE;
	ARM_ASSIGN(S,VAL);
END"ASSIGN";

BEGIN"SOJG"
	INTEGER I;
	STRING SL,SC;
	CODE_LINE[PTR3+1]←LINE_NO;
	GETNAME(FALSE,SL,VECTNAM);
	S←SC←SIMIO(ONE_LINE);
	SCAN(SC,HEAD,J);
	IF LENGTH(REF[PTR3+1]←SCAN(SC,ID,J))
	THEN BEGIN SC←BREAK&SC;
		I←INTSCAN(SC,J) END ELSE I←INTSCAN(S,J);
	SAY_WAIT;
	OPEN_ONE;
	ARM_SOJG(SL,I);
	GO TO GET1;
END"SOJG";

IFC THROWING THENC
BEGIN "THROW"
	INTEGER SUCCESS;
	REAL FORE, AFT;
	IF READT(TT1,S,"THROW - "&S&" RELEASE DOSN'T EXIST")
	∧ READV(XV,S,"THROW - "&S&" VELOCITY DOSN'T EXIST")
	∧ READT(XT,S,"THROW - "&S&" FINAL DOSN'T EXIST")
	THEN BEGIN
		GETNAME(TRUE,S,FUNNAM);
		FORE ← REALSCAN(S,BREAK);
		GETNAME(TRUE,S,FUNNAM);
		AFT ← REALSCAN(S,BREAK);
		SAY_WAIT;
		OPEN_ONE;
		THROW(TT1,XV,XT,FORE,AFT,SUCCESS);
		IF ¬SUCCESS THEN OUTSTR(" SORRY UNABLE TO THROW"&CRLF);
	END
END "THROW";


BEGIN "TOSS"
	INTEGER SUCCESS;
	REAL FORE, AFT, V;
	SAFE REAL OWN ARRAY VEL[1:4];
	IF READT(TT1,S,"TOSS - "&S&" RELEASE DOESN'T EXIST")
	∧ READV(XV,S,"TOSS - "&S&" TARGET DOESN'T EXIST")
	∧ READT(XT,S,"TOSS - "&S&" FINAL DOESN'T EXIST")
	THEN BEGIN
		GETNAME(TRUE,S,FUNNAM);
		V ← REALSCAN(S,BREAK);
		SAY_WAIT;
		OPEN_ONE;
		BALLIST(VEL,TT1,XV,V,SUCCESS);
		IF ¬SUCCESS THEN OUTSTR("NO BALLISTIC SOLUTION"&CRLF)
		ELSE THROW(TT1,VEL,XT,0.05,-0.05,SUCCESS);
		IF ¬SUCCESS THEN OUTSTR(" SORRY, CAN'T THROW"&CRLF);
	END;
END "TOSS";
ENDC
IFC GRAPHICS THENC
BEGIN "DISPLAY"
SAFE INTEGER ARRAY DISPLY[1:'3000];
LABEL TOP;
INTEGER POG;
SAFE INTEGER ARRAY FDATA[0:'2200];
STRING SIMPLE PROCEDURE SCAN_DATA(INTEGER TL,TU;STRING IND;SIMPLE PROCEDURE UP);
BEGIN	INTEGER ERROR,TICK,REQD,THIS,N;
	INTEGER MISSED;
	BOOLEAN FIRST;
	LABEL NEXT;
	LOOKUP('17,DFILE&".TMP",EOF);
	IF EOF THEN RETURN("FILE NOT FOUND");
	REQD←CVSIX(IND);
	TICK←CVSIX("TICK");
	ERROR←CVSIX("ERROR");
	TIME←-1;
	FIRST←TRUE;
	MISSED←0;
	PTR←0;
	BP←0;
	HIT←0;
	ARRYIN('17,FDATA[0],'200);
	DO BEGIN "READ_LOOP"
		ARRYIN('17,FDATA['200],'2000);
		DO BEGIN "ITEM_LOOP"
			THIS←FDATA[PTR] LAND '777777777700;
			IF ¬THIS THEN RETURN(NULL);
			IF THIS=TICK THEN BEGIN
				MISSED←0;
				TIME←TIME+1;
				IF TIME<TL THEN GO TO NEXT;
				IF TIME>TU THEN RETURN(NULL);
				HIT←HIT+1;
				IF MODULUS<2 ∨ ¬(HIT MOD MODULUS) THEN BEGIN
					BUFFER[BP+1]←BUFFER[BP];
					BP←BP+1;
				END;
			END;
			IF THIS=REQD THEN BEGIN	
				UP;
				IF FIRST THEN BEGIN
					BUFFER[1]←BUFFER[BP];
					ARRBLT(BUFFER[2],BUFFER[1],BP-2);
					FIRST←FALSE;
				END;
			END;
		NEXT:	IF(N←FDATA[PTR] LAND '77)>'37 ∨ THIS=ERROR THEN
			BEGIN	MISSED←-1;
				OUTSTR(CVS(TIME)&"	DATA MISSED");
			END;
			PTR←PTR+1+(IF MISSED THEN 0 ELSE N);
		END UNTIL PTR>'1777;
		PTR←PTR-'2000;
		ARRBLT(FDATA[0],FDATA['2000],'200);
	END UNTIL EOF;
	RETURN("END OF FILE");
END"SCAN_DATA";

PROCEDURE WHEN;
BEGIN 
	INTEGER I;
	PRELOAD_WITH "OPEN_HAND","CLOSE_HAND","WAIT_ARM","PLACE_ARM","CHANGE_ARM","SET_TOUCH","STOP_ARM",
"SAVE_ARM","RESTORE_ARM","CENTER_ARM","SET_ARM","WOBBLE_ARM","SEARCH_ARM",
"AOJ_ARM","SLAVE_ARM","GO_ARM","MOVE_ARM","SCREW_ARM";
	SAFE OWN STRING ARRAY FUNCTION[1:18];
	IF (I←FDATA[PTR+1] LAND '77) THEN SM←SM&CVS(TIME)&" "&FUNCTION[I]&CRLF ELSE
END;

SIMPLE PROCEDURE REAL6;
BEGIN
	INTEGER I;
	REAL R;
	I←FDATA[PTR+INDEX];
	START_CODE MOVE 1,I;FMPR 1,FACTOR;MOVEM 1,R END;
	BUFFER[BP]←R;
END;

SIMPLE PROCEDURE REAL1;
BEGIN
	INTEGER I;
	REAL R;
	I←FDATA[PTR+1];
	START_CODE MOVE 1,I;FMPR 1,FACTOR;MOVEM 1,R END;
	BUFFER[BP]←R;
END;

SIMPLE PROCEDURE INT1;BUFFER[BP]←FDATA[PTR+1];

SIMPLE PROCEDURE INT6;
	BUFFER[BP]←FDATA[PTR+INDEX];

PROCEDURE BIGHT;
BEGIN	LABEL FOUND;
	INTEGER BITE,T,I,J,K;
	SAFE INTEGER ARRAY FEEL[1:2,1:2,1:4];
	START_CODE
	HRRZI 1,FDATA;
	HRR 1,(1);
	ADD 1,PTR;
	HRLI 1,'1400;
	MOVEM 1,BITE;
	END;
	FOR I←2 STEP -1 UNTIL 1 DO BEGIN"FINGER"
		FOR J←2 STEP -1 UNTIL 1 DO
		FOR K←4 STEP -1 UNTIL 1 DO
		IF INDEX=I ∧ TIP=J ∧ PAD=K THEN
		BEGIN"THE ONE"
		T←ILDB(BITE);
		START_CODE
		LABEL POS,BACK;
		MOVE 1,T;
		TRNE 1,'2000;
		JRST POS;
		TRZ 1,'774000;
		JRST BACK;
	POS:	TDO 1,NMASK;
	BACK:	MOVNM 1,T;
		END;
		GO TO FOUND;
		END "THE ONE" ELSE IBP(BITE);
		IBP(BITE);
	END "FINGER";
FOUND:	BUFFER[BP]←T;
END;
STRING SL;
SL←SIMIO(ONE_LINE);
SCAN(SL,HEAD,BREAK);
IF ¬LENGTH(DFILE←SCAN(SL,ID,BREAK)) THEN DFILE←OFILE;
OPEN('17,"DSK",'17,0,0,120,BREAK,EOF);
MODULUS←1000;
SM←"
TIME FUNCTION"&CRLF;
SETFORMAT(4,0);
S11←SCAN_DATA(0,5000,"NEXT",WHEN);
SM←SM&CVS(TIME)&" "&S11&CRLF;
OUTSTR(SM);
OUTSTR("DISPLAY, FUNCTION, FROM, TO ?"&CRLF);
SETFORMAT(0,0);
WHILE TRUE DO BEGIN
INPUT(1,HEAD);S11←INPUT(1,ID);
IF EQU(S11,"X") THEN DONE;
IF EQU(S11,"N") THEN BEGIN RELEASE('17);GO TO GET END;
IF EQU(S11,"C") THEN BEGIN DPYCLR;RELEASE('17);GO TO GET END;
IF EQU(S11,"P") THEN BEGIN
	STRING FILNAM;
	INTEGER FLG,CHN;
	CHN ← 14;
	OPEN(CHN,"DSK",8,0,3,0,0,0);
	DO BEGIN
	OUTSTR(13&10&"PLOT FILE = ");
	FILNAM  ←  INCHWL;
	ENTER(CHN,FILNAM&".PLT",FLG);
	END UNTIL ¬FLG;
	ARRYOUT(CHN,DISPLY[1],DISPLY[2]);
	RELEASE(CHN);
	GO TO TOP;
END;
INPUT(1,HEAD);FUNCTION←INPUT(1,ID);
IF EQU(S11,"D")THEN BEGIN
LL←INTIN(1);
UL←INTIN(1);
MODULUS←1+(UL-LL)%100;
DPYCLR;
POG←GETPOG;
DPYSET(DISPLY);
AIVECT(-511,450);
END;
IF EQU(FUNCTION,"POS")THEN BEGIN
OUTSTR("INDEX ?"&CRLF);
INDEX←INTIN(1);
FACTOR←100.0;
SCAN_DATA(LL,UL,"THETA",REAL6);
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"POSITION ERROR 1/100 DEG"&CVS(INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;

IF EQU(FUNCTION,"VEL")THEN BEGIN
OUTSTR("INDEX ?"&CRLF);
INDEX←INTIN(1);
FACTOR←100.0;
SCAN_DATA(LL,UL,"VEL",REAL6);
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"VELOCITY ERROR 1/100 DEG"&CVS(INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;

IF EQU(FUNCTION,"MOTOR")THEN BEGIN
OUTSTR("INDEX ?"&CRLF);
INDEX←INTIN(1);
SCAN_DATA(LL,UL,"DAC",INT6);
FOR I←1 STEP 1 UNTIL BP DO BUFFER[I]←BUFFER[I]*300/'776000;
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"MOTOR "&CVS(INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"DRIVE")THEN BEGIN
OUTSTR("INDEX ?"&CRLF);
INDEX←INTIN(1);
FACTOR←10.0;
SCAN_DATA(LL,UL,"BACK",REAL6);
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"DRIVE "&CVS(7-INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
BP←HIT←0;
SCAN_DATA(LL,UL,"FORD",REAL6);
ARRGRF(BUFFER,1,BP,-300,-300,0,700,"T/"&CVS(MODULUS),
"DRIVE "&CVS(7-INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"HAND")THEN BEGIN
FACTOR←100.0;
SCAN_DATA(LL,UL,"HAND",REAL1);
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"HAND    FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"TIME")THEN BEGIN
SCAN_DATA(LL,UL,"TICK",INT1);
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"TIME  FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"TOUCH")THEN BEGIN
OUTSTR("FINGER, TIP ?"&CRLF);
INDEX←INTIN(1);
TIP←INTIN(1);
FOR PAD←1 STEP 1 UNTIL 4 DO BEGIN
SCAN_DATA(LL,UL,"TOUCH",BIGHT);
ARRGRF(BUFFER,1,BP,-300,-300+(PAD-1)*180,800,150,"T/"&CVS(MODULUS),
"TOUCH   FROM "&CVS(LL)&" TO "&CVS(UL));
END;
DPYOUT(POG);
GO TO TOP;
END;
OUTSTR("UNRECOGINZED COMMAND"&CRLF);
TOP:END;
END"DISPLAY";
ENDC

END ELSE
BEGIN
FOR I←1 STEP 1 UNTIL FMN DO IF EQU(S,MACRO_NAME[I])
THEN BEGIN
	S←SIMIO(ONE_LINE);
	SL←NULL;FOR J←1 STEP 1 UNTIL MAC DO SL←SL&"   ";
	IF MAC THEN OUTSTR(SL&MACRO_NAME[I]&CRLF) ELSE OUTSTR("O.K."&CRLF);
	MAC←MAC+1;
	MACRO_SOURCE[MAC]←MACRO_DEFN[I];
	MAC_TOP[MAC]←MAC_FREE;
	WHILE LENGTH(S) DO BEGIN
		SCAN(S,SOME,BREAK);
	IF BREAK="$"
	THEN BEGIN I←INTSCAN(S,BREAK);
	     I←I+MAC_TOP[MAC-1];
	     IF I<1 ∨ I> MAC_TOP[MAC]
	     THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"MACRO PARAMETER OUT OF RANGE"&'15&'12);
		  GO TO GET END;
	     SL←MAC_PAR[I] END
	ELSE SL←IF "A"≤ BREAK ≤"Z" THEN SCAN(S,ID,I) ELSE SCAN(S,NNUMS,I);
		IF LENGTH(SL) THEN MAC_PAR[MAC_FREE←MAC_FREE+1]←SL END;
	BBEG[MAC]←PTR3+1;
	LLAB[MAC]←FREEL+1;
	GO TO GET1;
END;

OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNRECOGINIZED COMMAND"&CRLF);
END;
GO TO GET;